'  ==========================================================================
'  |                                                                        |
'  | SQLitening Aux Ruts                                                    |
'  |                                                                        |
'  ==========================================================================
'
'  Contains auxiliary routines called by SQLitening.Dll.  These ruts are used
'  to Encrypt/Decrypt and Compress/Uncompress.  This Dll is not loaded until
'  it is called the first time.  If you require different cryption or compression
'  then replace this Dll with your own.  Your custom Dll must have the
'  following exported function.
'     Function AuxRutsA alias "AuxRutsA" (byval rlAction as Long, _
'                                         rsTextIn as String, _
'                                         wsTextOut as String) Export as Long
'  The possible actions are:
'     1 = Set crypt key  Empty Text1 will
'         remove key, use for security reasons.
'     2 = Encrypt
'     3 = Decrypt
'     4 = Compress
'     5 = Uncompress
'     6 = Compress and Encrypt
'     7 = Convert to Hexadecimal
'     8 = Decrypt and Uncompress
'
'  ==========================================================================
'  PUBLIC DOMAIN SOFTWARE
'  The author or authors of this code dedicate any and all
'  copyright interest in this code to the public domain.
'  Anyone is free to copy, modify, publish, use, compile,
'  sell, or distribute the original code, either in source
'  code form or as a compiled binary, for any purpose,
'  commercial or non-commercial, and by any means.
'  Fred Meier - July 2010
'  ==========================================================================

#Compile Dll "..\Bin\SQLiteningAuxRuts.Dll"
#Dim All

'=================<[ Constants, Equates, and Types ]>==================
%VERIFY_IMPLEMENTATION = 1
DEFLNG A-Z
%MAX_ROUNDS    = 14
%MIN_ROUNDS    = 10
%BLOCKSIZE     = 16
%SUBKEY_SIZE   = (%BLOCKSIZE*2*8)   '256
%MAX_KEY_BYTES = (%BLOCKSIZE*2)
%ENCRYPT       = 1
%DECRYPT       = 2
%MaxUncompressSize = 500000000

TYPE ENCRYPTION_CONTEXT
   Action        AS LONG
   Rounds        AS LONG
   UserKeyLength AS LONG
   UserKey       AS LONG PTR
   InBlock       AS LONG PTR
   OutBlock      AS LONG PTR
   KeyBlocks     AS LONG                  '4*4-byte blocks
   KE            AS LONG PTR              '<-- pointer to encryption subkey buffer
   KE_Buffer     AS STRING * %SUBKEY_SIZE '<-- encryption subkey buffer
   KD            AS LONG PTR              '<-- pointer to decryption subkey buffer
   KD_Buffer     AS STRING * %SUBKEY_SIZE '<-- decryption subkey buffer
   Se            AS BYTE PTR
   Sd            AS BYTE PTR
   Te0           AS LONG PTR
   Te1           AS LONG PTR
   Te2           AS LONG PTR
   Te3           AS LONG PTR
   Td0           AS LONG PTR
   Td1           AS LONG PTR
   Td2           AS LONG PTR
   Td3           AS LONG PTR
   Rcon          AS LONG PTR
END TYPE

'============================<[ Declares ]>============================
Declare Function Compress Lib "ZLib.dll" Alias "compress"(compr As Any, comprLen As Dword, buf As Any, byval buflen As Dword)As Long
Declare Function Uncompress Lib "ZLib.dll" Alias "uncompress"(uncompr As Any, uncomprLen As Dword, compr As Any, byval lcompr As Dword)As Long

'=============================<[ Global ]>=============================
Threaded tlFlags as Long                       : %gbfKeyIsSet = &H01
Threaded tuCTX as ENCRYPTION_CONTEXT

'======================<[ Rijndael Encryption ]>=======================
'   Rijndael has been selected by the NIST as "the AES [Advanced
'   Encryption Standard] algorithm" and is described in FIPS-197, which is
'   available here: http://csrc.nist.gov/publications/fips/fips197/fips-197.pdf
'
'   Rijndael is free for any use public or private, commercial or
'   non-commercial.  The authors of Rijndael provide a home page for the
'   algorithm: http://www.esat.kuleuven.ac.be/~rijmen/rijndael/
'
'   The PowerBASIC implementation appearing below, which meets the AES
'   standard for 16-byte block operations, is based in part on java
'   routines written and placed in the public domain by Paulo Barreto.
'   The PB implementation is hereby placed in the public domain.  Use it
'   as you wish.  My hope is discourage reliance on home-grown encryption
'   schemes in favor of well-examined, strong, freely available
'   algorithms.
'
'    Implementation Notes
'   -- The algorithm operates on plaintext blocks of 16 bytes.  Encryption
'   of shorter blocks is possible only by padding the plaintext (often
'   with zero bytes), which can be accomplished through several methods.
'   The simplest of them assumes that the final byte of plaintext always
'   identifies the number of bytes of padding added, including the final
'   byte itself.
'
'   Examples:
'      total plaintext bytes         = 30
'      plaintext blocks encrypted:   = 2
'      final block                   = chr$(x1 to x14) + chr$(0,2)
'      total plaintext bytes         = 40
'      plaintext blocks encrypted:   = 3
'      final block                   = chr$(x1 to x8) + chr$(0,0,0,0,0,0,0,8)
'   -- Encryption key lengths can range from 1 to 32 bytes (8 to 256 bits).
'   -- Implementation here is handled through an #INCLUDE file.  No global
'   data is employed.
'   -- As presented, the code does not supply a ready-to-use encryption
'   application.  It offers necessary pieces only, as well as an
'   illustration of their use.  Always keep in mind that most encryption
'   is broken because of implementation flaws and weaknesses.
'   -- Like most encryption algorithms, Rijndael was designed on
'   big-endian systems.  For this reason, little-endian systems return
'   correct test vector results only through considerable byte-swapping,
'   with efficiency suffering as a result.  Because it adds nothing to the
'   encryption security, an efficient implementation should avoid the
'   byte-swapping.  Here the equate %VERIFY_IMPLEMENTATION can be remmed
'   to avoid this byte-swapping.
'   -- Because of the methods of data handling required for most
'   encryption and hashing, PowerBASIC's LONGs should be used to assure
'   correct bit-level results (as well as additional speed).
'   Greg Turgeon 08/2002

'--------------------
'-- Utility macros
'--------------------
MACRO zbs(xx)=string$(xx,0)
'--------------------

MACRO FUNCTION shiftlc(xx,constant_shiftval)
retval = (xx)
!  shl   retval, constant_shiftval
END MACRO = retval
'--------------------

MACRO FUNCTION shiftrc(xx,constant_shiftval)
retval = (xx)
!  shr   retval, constant_shiftval
END MACRO = retval
'--------------------

MACRO FUNCTION byte3(xx)
retval = (xx)
!  mov   eax, retval
!  shr   eax, 24
!  mov   retval, eax
END MACRO = retval
'--------------------

MACRO FUNCTION byte2(xx)
retval = (xx)
!  mov   eax, retval
!  shr   eax, 16
!  and   eax, &hff
!  mov   retval, eax
END MACRO = retval
'--------------------

MACRO FUNCTION byte1(xx)
retval = (xx)
!  mov   eax, retval
!  shr   eax, 8
!  and   eax, &hff
!  mov   retval, eax
END MACRO = retval
'--------------------

MACRO FUNCTION byte0(xx)
retval = (xx)
!  mov   eax, retval
!  and   eax, &hff
!  mov   retval, eax
END MACRO = retval
'--------------------

MACRO FUNCTION get_block(mem_ptr)
!  mov   edx, mem_ptr
!  mov   eax, [edx]
#IF %def(%VERIFY_IMPLEMENTATION)
!  bswap eax
#ENDIF
!  mov   retval, eax
!  add   edx, 4
!  mov   mem_ptr, edx
END MACRO = retval
'--------------------

MACRO put_block(mem_ptr,value)
retval=value
!  mov   edx, retval
#IF %def(%VERIFY_IMPLEMENTATION)
!  bswap edx
#ENDIF
!  mov   eax, mem_ptr
!  mov   [eax], edx
!  add   eax, 4
!  mov   mem_ptr, eax
END MACRO
DECLARE FUNCTION Rijndael_Init&(Ctx AS ENCRYPTION_CONTEXT)
DECLARE FUNCTION Set_Key&(Ctx AS ENCRYPTION_CONTEXT)
DECLARE FUNCTION MakeDecryptKeySchedule(Ctx AS ENCRYPTION_CONTEXT)
DECLARE FUNCTION EncryptBlock&(Ctx AS ENCRYPTION_CONTEXT)
DECLARE FUNCTION DecryptBlock&(Ctx AS ENCRYPTION_CONTEXT)
Declare Sub      ExitProcess LIB "KERNEL32.DLL" Alias "ExitProcess" (byval uExitCode as Long)

FUNCTION Set_Key&(Ctx AS ENCRYPTION_CONTEXT)
'   Returns zero if OK or -17 if key invalid
LOCAL i&, n&, nk&, pblock&, r&, temp&, t&, u&, v&, retval&
LOCAL in_ukey$, in_key AS LONG PTR, k AS LONG PTR, s AS BYTE PTR
select case as long Ctx.UserKeyLength
   case 16
      Ctx.Rounds = 10
   case 24
      Ctx.Rounds = 12
   case 32
      Ctx.Rounds = 14
   case else
      function = -17
      exit function
end select
Ctx.KeyBlocks = (Ctx.Rounds+1)*4
Rijndael_Init Ctx
in_ukey$ = zbs(%MAX_KEY_BYTES)
in_key = strptr(in_ukey$)
pblock = Ctx.UserKey
k = Ctx.KE  'local copy
for i = 0 to (Ctx.Rounds-6)-1
   @k[i] = get_block(pblock)
next i
s = Ctx.Se
i = Ctx.Rounds - 6 : nk = i : n = 0
do while i < Ctx.KeyBlocks
   temp = @k[i-1]
   if n = 0 then
      n = Nk
      t = byte2(temp)
      v = shiftlc(@s[t],24)
      t = byte1(temp) : u = shiftlc(@s[t],16)
      v = v OR u
      t = byte0(temp) : u = shiftlc(@s[t],8)
      v = v OR u
      u = @s[byte3(temp)]
      temp = (v OR u) XOR Ctx.@Rcon[r] : incr r
   else
      if ((Nk = 8) AND (n = 4)) then
         t = byte3(temp)
         v = shiftlc(@s[t],24)
         t = byte2(temp) : u = shiftlc(@s[t],16)
         v = v OR u
         t = byte1(temp) : u = shiftlc(@s[t],8)
         v = v OR u
         u = @s[temp AND &hff]
         temp = v OR u
      end if
   end if
   @k[i] = @k[i-nk] XOR temp
   incr i : decr n
loop
if Ctx.Action = %DECRYPT then MakeDecryptKeySchedule Ctx
END FUNCTION
'--------------------

MACRO FUNCTION imix(tt)
u =       Ctx.@Td0[Ctx.@Se[byte3(tt)]]
u = u XOR Ctx.@Td1[Ctx.@Se[byte2(tt)]]
u = u XOR Ctx.@Td2[Ctx.@Se[byte1(tt)]]
u = u XOR Ctx.@Td3[Ctx.@Se[tt AND &hff]]
END MACRO = u
'====================

FUNCTION MakeDecryptKeySchedule(Ctx AS ENCRYPTION_CONTEXT)
LOCAL d&, e&, i&, retval&, t&, u&, k AS LONG PTR
k = Ctx.KD
d = 0 : e = Ctx.Rounds*4
@k[d]   = Ctx.@KE[e]   : @k[d+1] = Ctx.@KE[e+1]
@k[d+2] = Ctx.@KE[e+2] : @k[d+3] = Ctx.@KE[e+3]
d = d + 4 : e = e - 4
for i = 1 to Ctx.Rounds-1
   t = Ctx.@KE[e]   : @k[d]   = imix(t)
   t = Ctx.@KE[e+1] : @k[d+1] = imix(t)
   t = Ctx.@KE[e+2] : @k[d+2] = imix(t)
   t = Ctx.@KE[e+3] : @k[d+3] = imix(t)
   d = d + 4 : e = e - 4
next i
@k[d]   = Ctx.@KE[e]   : @k[d+1] = Ctx.@KE[e+1]
@k[d+2] = Ctx.@KE[e+2] : @k[d+3] = Ctx.@KE[e+3]
END FUNCTION
'--------------------

MACRO FUNCTION packbytes(aa,bb,cc,dd)
aa = shiftlc(aa,24)
bb = shiftlc(bb,16)
cc = shiftlc(cc,8)
END MACRO = (aa OR bb OR cc OR dd)
'--------------------

MACRO FUNCTION enc_ta(aa,bb,cc,dd)
u =       Ctx.@Te0[byte3(aa)]
u = u XOR Ctx.@Te1[byte2(bb)]
u = u XOR Ctx.@Te2[byte1(cc)]
u = u XOR Ctx.@Te3[dd AND &hff]
END MACRO = u
'--------------------

MACRO FUNCTION enc_tal(aa,bb,cc,dd,ww)
u = Ctx.@Se[byte3(aa)] : v = shiftrc(ww,24)
a0 = u XOR v
u = Ctx.@Se[byte2(bb)] : v = shiftrc(ww,16)
a1 = (u XOR v) AND &hff
u = Ctx.@Se[byte1(cc)] : v = shiftrc(ww,8)
a2 = (u XOR v) AND &hff
u = Ctx.@Se[dd AND &hff] : v = ww
a3 = (u XOR v) AND &hff
retval = packbytes(a0,a1,a2,a3)
END MACRO = retval
'====================

FUNCTION EncryptBlock&(Ctx AS ENCRYPTION_CONTEXT)
LOCAL r&, t&, u&, v&, w&, pblock&, retval&, k AS LONG PTR
LOCAL a0&, a1&, a2&, a3&, t0&, t1&, t2&, t3&, s0&, s1&, s2&, s3&
pblock = Ctx.InBlock
t0 = get_block(pblock) : t1 = get_block(pblock)
t2 = get_block(pblock) : t3 = get_block(pblock)
k = Ctx.KE
t0 = t0 XOR @k[0] : t1 = t1 XOR @k[1]
t2 = t2 XOR @k[2] : t3 = t3 XOR @k[3]
for r = 1 to Ctx.Rounds-1
   k = k + (4*4)
   t = enc_ta(t0,t1,t2,t3) : a0 = t XOR @k[0]
   t = enc_ta(t1,t2,t3,t0) : a1 = t XOR @k[1]
   t = enc_ta(t2,t3,t0,t1) : a2 = t XOR @k[2]
   t = enc_ta(t3,t0,t1,t2) : a3 = t XOR @k[3]
   t0 = a0 : t1 = a1 : t2 = a2 : t3 = a3
next r
k = k + (4*4)
w = @k[0] : s0 = enc_tal(t0,t1,t2,t3,w)
w = @k[1] : s1 = enc_tal(t1,t2,t3,t0,w)
w = @k[2] : s2 = enc_tal(t2,t3,t0,t1,w)
w = @k[3] : s3 = enc_tal(t3,t0,t1,t2,w)
pblock = Ctx.OutBlock
put_block(pblock,s0) : put_block(pblock,s1)
put_block(pblock,s2) : put_block(pblock,s3)
END FUNCTION
'--------------------

MACRO FUNCTION dec_ta(aa,bb,cc,dd)
u =       Ctx.@Td0[byte3(aa)]
u = u XOR Ctx.@Td1[byte2(bb)]
u = u XOR Ctx.@Td2[byte1(cc)]
u = u XOR Ctx.@Td3[dd AND &hff]
END MACRO = u
'--------------------

MACRO FUNCTION dec_tal(aa,bb,cc,dd,ww)
u = Ctx.@Sd[byte3(aa)] : v = shiftrc(ww,24)
a0 = u XOR v
u = Ctx.@Sd[byte2(bb)] : v = shiftrc(ww,16)
a1 = (u XOR v) AND &hff
u = Ctx.@Sd[byte1(cc)] : v = shiftrc(ww,8)
a2 = (u XOR v) AND &hff
u = Ctx.@Sd[dd AND &hff] : v = ww
a3 = (u XOR v) AND &hff
retval = packbytes(a0,a1,a2,a3)
END MACRO = retval
'====================

FUNCTION DecryptBlock&(Ctx AS ENCRYPTION_CONTEXT)
LOCAL r&, t&, u&, v&, w&, pblock&, retval&, k AS LONG PTR
LOCAL a0&, a1&, a2&, a3&, t0&, t1&, t2&, t3&, s0&, s1&, s2&, s3&
pblock = Ctx.InBlock
t0 = get_block(pblock) : t1 = get_block(pblock)
t2 = get_block(pblock) : t3 = get_block(pblock)
k = Ctx.KD
t0 = t0 XOR @k[0] : t1 = t1 XOR @k[1]
t2 = t2 XOR @k[2] : t3 = t3 XOR @k[3]
for  r = 1 to Ctx.Rounds-1
   k = k + (4*4)
   t = dec_ta(t0,t3,t2,t1) : a0 = t XOR @k[0]
   t = dec_ta(t1,t0,t3,t2) : a1 = t XOR @k[1]
   t = dec_ta(t2,t1,t0,t3) : a2 = t XOR @k[2]
   t = dec_ta(t3,t2,t1,t0) : a3 = t XOR @k[3]
   t0 = a0 : t1 = a1 : t2 = a2 : t3 = a3
next r
k = k + (4*4)
w = @k[0] : s0 = dec_tal(t0,t3,t2,t1,w)
w = @k[1] : s1 = dec_tal(t1,t0,t3,t2,w)
w = @k[2] : s2 = dec_tal(t2,t1,t0,t3,w)
w = @k[3] : s3 = dec_tal(t3,t2,t1,t0,w)
pblock = Ctx.OutBlock
put_block(pblock,s0) : put_block(pblock,s1)
put_block(pblock,s2) : put_block(pblock,s3)
END FUNCTION
'====================

FUNCTION Rijndael_Init&(Ctx AS ENCRYPTION_CONTEXT)
STATIC table_buffer$
STATIC se AS BYTE PTR, te0 AS LONG PTR, te1 AS LONG PTR, te2 AS LONG PTR,  te3 AS LONG PTR
STATIC sd AS BYTE PTR, td0 AS LONG PTR, td1 AS LONG PTR, td2 AS LONG PTR,  td3 AS LONG PTR
STATIC rcon AS LONG PTR
Ctx.KE_Buffer = zbs(%SUBKEY_SIZE)
Ctx.KE        = varptr(Ctx.KE_Buffer)
Ctx.KD_Buffer = zbs(%SUBKEY_SIZE)
Ctx.KD        = varptr(Ctx.KD_Buffer)
if te0 = 0 then gosub MakeTables
Ctx.Se        = se
Ctx.Sd        = sd
Ctx.Te0       = te0
Ctx.Te1       = te1
Ctx.Te2       = te2
Ctx.Te3       = te3
Ctx.Td0       = td0
Ctx.Td1       = td1
Ctx.Td2       = td2
Ctx.Td3       = td3
Ctx.Rcon      = rcon
exit function
'============
MakeTables:
LOCAL ss AS BYTE PTR
LOCAL root&, s1&, s2&, s3&, i1&, i2&, i4&, i8&, i9&, ib&, id&, ie&, t&, u&, v&, retval&
table_buffer$ = zbs((1024*8)+(256*2)+(40))
te0 = strptr(table_buffer)
te1 = (te0+1024)   : te2 = te0+(1024*2) : te3  = te0+(1024*3)
td0 = te0+(1024*4) : td1 = te0+(1024*5) : td2  = te0+(1024*6) : td3 = te0+(1024*7)
se  = te0+(1024*8) : sd  = se+256       : rcon = se+(256*2)
root = &h11B
ss = codeptr(SS_Table)
for i1 = 0 to 255
   s1 = @ss[i1]
   s2 = shiftlc(s1,1)
   if (s2 >= &h100) then s2 = s2 XOR root
   s3 = s2 XOR s1
   i2 = shiftlc(i1,1)
   if (i2 >= &h100) then i2 = i2 XOR root
   i4 = shiftlc(i2,1)
   if (i4 >= &h100) then i4 = i4 XOR root
   i8 = shiftlc(i4,1)
   if (i8 >= &h100) then i8 = i8 XOR root
   i9 = i8 XOR i1
   ib = i9 XOR i2
   id = i9 XOR i4
   ie = i8 XOR i4 XOR i2
   @se[i1] = s1 AND 255
   u = shiftlc(s2,24)
   v = shiftlc(s1,16)
   t = u OR v
   u = shiftlc(s1,8)
   t = t OR u OR s3
   @te0[i1] = t
   u = shiftrc(t,8)
   v = shiftlc(t,24)
   @te1[i1] = u OR v
   u = shiftrc(t,16)
   v = shiftlc(t,16)
   @te2[i1] = u OR v
   u = shiftrc(t,24)
   v = shiftlc(t,8)
   @te3[i1] = u OR v
   @sd[s1] = i1 AND 255
   u = shiftlc(ie,24)
   v = shiftlc(i9,16)
   t = u OR v
   u = shiftlc(id,8)
   t = t OR u OR ib
   @td0[s1] = t
   u = shiftrc(t,8)
   v = shiftlc(t,24)
   @td1[s1] = u OR v
   u = shiftrc(t,16)
   v = shiftlc(t,16)
   @td2[s1] = u OR v
   u = shiftrc(t,24)
   v = shiftlc(t,8)
   @td3[s1] = u OR v
next i1
LOCAL i&, r&
r = 1
@rcon[0] = shiftlc(r,24)
for i = 1 to 9
   r = shiftlc(r,1)
   if (r >= &h100) then r = r XOR ROOT
   @rcon[i] = shiftlc(r,24)
next i
RETURN
SS_Table:
! DD  &h7b777c63, &hc56f6bf2, &h2b670130, &h76abd7fe
! DD  &h7dc982ca, &hf04759fa, &hafa2d4ad, &hc072a49c
! DD  &h2693fdb7, &hccf73f36, &hf1e5a534, &h1531d871
! DD  &hc323c704, &h9a059618, &he2801207, &h75b227eb
! DD  &h1a2c8309, &ha05a6e1b, &hb3d63b52, &h842fe329
! DD  &hed00d153, &h5bb1fc20, &h39becb6a, &hcf584c4a
! DD  &hfbaaefd0, &h85334d43, &h7f02f945, &ha89f3c50
! DD  &h8f40a351, &hf5389d92, &h21dab6bc, &hd2f3ff10
! DD  &hec130ccd, &h1744975f, &h3d7ea7c4, &h73195d64
! DD  &hdc4f8160, &h88902a22, &h14b8ee46, &hdb0b5ede
! DD  &h0a3a32e0, &h5c240649, &h62acd3c2, &h79e49591
! DD  &h6d37c8e7, &ha94ed58d, &heaf4566c, &h08ae7a65
! DD  &h2e2578ba, &hc6b4a61c, &h1f74dde8, &h8a8bbd4b
! DD  &h66b53e70, &h0ef60348, &hb9573561, &h9e1dc186
! DD  &h1198f8e1, &h948ed969, &he9871e9b, &hdf2855ce
! DD  &h0d89a18c, &h6842e6bf, &h0f2d9941, &h16bb54b0
END FUNCTION

'===========================<[ Aux Ruts A ]>===========================
Function AuxRutsA alias "AuxRutsA" (byval rlAction as Long, _
                                    rsTextIn as String, _
                                    wsTextOut as String) Export as Long
'   Action is:
'     1 = Set crypt key from TextIn. TextOut is not used.  Empty TextIn 
'         will remove key, use for security reasons.
'     2 = Encrypt TextIn into TextOut.
'     3 = Decrypt TextIn into TextOut.
'     4 = Compress TextIn into TextOut.
'     5 = Uncompress TextIn into TextOut.
'     6 = Compress and Encrypt TextIn into TextOut.
'     7 = Convert to Hexadecimal from TextIn into TextOut.
'     8 = Decrypt and Uncompress TextIn into TextOut.
'   Returns zero if OK or an error number -17 or -19 if error occurs.

   Local llDo as Long
   Local lsText as String
   Local lspIn, lspOut as String Ptr
   Local ltpA as Byte ptr

   ' Init stuff
   lspIn = varptr(rsTextIn)
   lspOut = varptr(wsTextOut)

   ' Process action
   select case const rlAction
   case 1   ' crypt key
      if len(rsTextIn) then
         tuCTX.Action = %DECRYPT
         tuCTX.UserKey = strptr(rsTextIn)
         tuCTX.UserKeyLength = len(rsTextIn)
         llDo = Set_Key&(tuCTX)
         if llDo then function = llDo : exit function
         tlFlags = tlFlags or %gbfKeyIsSet
      else
         if tuCTX.KE then poke$ tuCTX.KE, zbs(sizeof(tuCTX.KE_Buffer))
         if tuCTX.KD then poke$ tuCTX.KD, zbs(sizeof(tuCTX.KD_Buffer))
         tlFlags = tlFlags and not %gbfKeyIsSet
      end if

   case 2   ' encrypt
      llDo = len(@lspIn) mod %BLOCKSIZE
      lsText = @lspIn & string$(%BLOCKSIZE - llDo, chr$(%BLOCKSIZE - llDo))
      lspIn = varptr(lsText)
      gosub EncryptRut

   case 3   ' decrypt
      gosub DecryptRut

   case 4   ' compress
      gosub CompressRut

   case 5   ' uncompress
      DoUncompress:
      if cvdwd(@lspIn) > %MaxUncompressSize then function = -19 : exit function
      @lspOut = space$(cvdwd(@lspIn))
      Uncompress byval strptr(@lspOut), len(@lspOut), byval strptr(@lspIn) + 4, len(@lspIn) - 4

   case 6   ' compress and encrypt
      lspOut = varptr(lsText)
      gosub CompressRut
      lspIn = lspOut
      lspOut = varptr(wsTextOut)
      llDo = len(@lspIn) mod %BLOCKSIZE
      @lspIn = @lspIn & string$(%BLOCKSIZE - llDo, chr$(%BLOCKSIZE - llDo))
      gosub EncryptRut

   case 7   ' convert to hexadecimal
      ltpA = strptr(rsTextIn)
      reset wsTextOut
      for llDo = 1 to len(rsTextIn)
         wsTextOut = wsTextOut & hex$(@ltpA[llDo - 1],2)
      next

   case 8   ' decrypt and uncompress
      lspOut = varptr(lsText)
      gosub DecryptRut
      lspIn = lspOut
      lspOut = varptr(wsTextOut)
      Goto DoUncompress

   case else
      function = -19
   end select
   exit function

EncryptRut:
   if isfalse (tlFlags and %gbfKeyIsSet) then function = -17 : exit function
   tuCTX.Action = %ENCRYPT
   tuCTX.InBlock = strptr(@lspIn)
   @lspOut = space$(len(@lspIn))
   tuCTX.OutBlock = strptr(@lspOut)
   for llDo = 1 to (len(@lspIn) \ %BLOCKSIZE)  '<-- Required: (len(plain$) mod 16) = 0
      EncryptBlock tuCTX
      tuCTX.InBlock  = tuCTX.InBlock  + %BLOCKSIZE
      tuCTX.OutBlock = tuCTX.OutBlock + %BLOCKSIZE
   next
   return

DecryptRut:
   if isfalse (tlFlags and %gbfKeyIsSet) then function = -17 : exit function
   tuCTX.Action = %DECRYPT
   tuCTX.InBlock = strptr(@lspIn)
   @lspOut = space$(len(@lspIn))
   tuCTX.OutBlock = strptr(@lspOut)

   for llDo = 1 to (len(@lspIn) \ %BLOCKSIZE)  '<-- Required: (len(plain$) mod 16) = 0
      DecryptBlock tuCTX
      tuCTX.InBlock  = tuCTX.InBlock  + %BLOCKSIZE
      tuCTX.OutBlock = tuCTX.OutBlock + %BLOCKSIZE
   next
   @lspOut = left$(@lspOut, -cvbyt(right$(@lspOut, 1)))
   return

CompressRut:
   if len(@lspIn) > %MaxUncompressSize then function = -19 : exit function
   @lspOut = space$(len(@lspIn) * 1.2 + 12)
   llDo = len(@lspOut)
   Compress byval strptr(@lspOut), llDo, byval strptr(@lspIn), len(@lspIn)
   @lspOut = mkdwd$(len(@lspIn)) & left$(@lspOut, llDo)
   return

End Function

'============================<[ LibMain ]>=============================
%DLL_PROCESS_ATTACH                          = 1
%DLL_THREAD_ATTACH                           = 2
%DLL_THREAD_DETACH                           = 3
%DLL_PROCESS_DETACH                          = 0
FUNCTION LibMain(BYVAL InstDLL    AS LONG, _
                 BYVAL Reason   AS LONG, _
                 BYVAL Reserved AS LONG) EXPORT AS LONG
' InstDLL is the DLL's instance handle.  This handle is used by the calling
'    application to identify the DLL being called.
' Reason specifies a flag indicating why the DLL entry-point is being called.
'    It can be one of the following values:
'    %DLL_PROCESS_ATTACH: Indicates that the DLL is being loaded by another process
'    (a DLL or EXE is loading the DLL).  DLLs can use this opportunity to initialize
'    any instance or global data, such as arrays.
'    %DLL_PROCESS_DETACH: Indicates that the DLL is being unloaded or detached from
'    the calling application.  DLLs can take this opportunity to clean up all
'    resources for all threads attached and known to the DLL.
'    %DLL_THREAD_ATTACH: Indicates that the DLL is being loaded by a new thread in
'    the calling application.  DLLs can use this opportunity to initialize any thread
'    local storage (TLS).
'    %DLL_THREAD_DETACH: Indicates that the thread is exiting cleanly.  If the DLL
'    has allocated any thread local storage, it should be released.
' Reserved specifies further aspects of the DLL initialization and cleanup.  If
'    Reason is %DLL_PROCESS_ATTACH, Reserved is NULL (zero) for dynamic loads
'    and non-NULL for static loads.  If Reason is %DLL_PROCESS_DETACH, Reserved
'    is NULL if LibMain has been called by using the FreeLibrary API call and
'    non-NULL if LibMain has been called during process termination.
' Return: If LibMain is called with %DLL_PROCESS_ATTACH, your LibMain function should
'    return a zero (0) if any part of your initialization process fails or a one (1)
'    if no errors were encountered.  If a zero is returned, Windows will abort and
'    unload the DLL from memory. When LibMain is called with any other value than
'    %DLL_PROCESS_ATTACH, the return value is ignored.

   select case reason
   case %DLL_THREAD_DETACH, %DLL_PROCESS_DETACH
      if tuCTX.KE then poke$ tuCTX.KE, zbs(sizeof(tuCTX.KE_Buffer))
      if tuCTX.KD then poke$ tuCTX.KD, zbs(sizeof(tuCTX.KD_Buffer))
   end select

   function = 1

End Function

